library(qs)
library(Seurat)
library(tidyverse)
library(miloDE)
library(sessioninfo)
library(EnhancedVolcano)
library(pals)
library(scMisc)Reproducing the figures of the manuscript
Introduction
This markdown document reproduces the figures of the manuscript: Multi-omic characterization of human sural nerves across polyneuropathies. All relevant data are automatically downloaded from Zenodo.
Instructions on how to restore the environment using renv or Docker can be found in the corresponding GitHub repository. The corresponding website, which contains interactive visualizations of the single nucleus transcriptomics and spatial transcriptomics data, is available at pns-atlas.mzhlab.com. If you have any questions, please contact us at mheming.de.
Load libraries
Figure 1
UMAP of all cells (Figure 1B)
options(timeout = 3600)
if (!file.exists("umap_figure.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/umap_figure.qs?download=1",
"umap_figure.qs"
)
}
umap_figure <- qread("umap_figure.qs")
DimPlot(
umap_figure,
reduction = "umap.scvi.full",
pt.size = .1,
alpha = .1,
cols = umap_figure@misc$cluster_col,
label = TRUE,
raster = FALSE
) +
NoLegend() +
theme(
axis.text = element_blank(),
axis.ticks = element_blank()
) +
xlab("UMAP_1") +
ylab("UMAP_2")Figure 2
UMAP immune cells (Figure 2A)
if (!file.exists("ic_figure.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/ic_figure.qs?download=1",
"ic_figure.qs"
)
}
ic_figure <- qread("ic_figure.qs")
DimPlot(
ic_figure,
reduction = "umap.rpca",
pt.size = .1,
alpha = .3,
cols = ic_figure@misc$ic_cluster_col,
label = TRUE,
raster = FALSE
) +
theme(
axis.text = element_blank(),
axis.ticks = element_blank()
) +
NoLegend() +
xlab("UMAP1") +
ylab("UMAP2")Feature plots immune cells (Figure 2B)
FeaturePlot(
ic_figure,
features = c("MS4A7", "CX3CR1", "TREM2", "LYVE1", "FOLR2", "TIMD4"),
reduction = "umap.rpca",
pt.size = 0.1,
raster = FALSE,
coord.fixed = TRUE,
cols = c("#F0F0F0", "#CB181D"),
order = TRUE,
ncol = 3
) &
theme(
axis.text = element_blank(),
axis.ticks = element_blank()
) &
xlab("UMAP1") &
ylab("UMAP2")Enrichment of gene ontology terms in markers genes of Macro 18 (Figure 2B)
if (!file.exists("enrichr_macro18.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/enrichr_macro18.qs?download=1",
"enrichr_macro18.qs"
)
}
enrichr_macro18 <- qread("enrichr_macro18.qs")
enrichr_macro18 |>
dplyr::slice_min(order_by = Adjusted.P.value, n = 10, with_ties = FALSE) |>
tidyr::separate(Overlap, into = c("overlap1", "overlap2")) |> # separate overlap in two columns
dplyr::mutate(Term = gsub(x = Term, pattern = "\\s\\(.+\\)", replacement = "")) |>
dplyr::mutate(overlap = as.numeric(overlap1) / as.numeric(overlap2)) |> # calculcate overlap
ggplot(aes(y = reorder(Term, -log10(Adjusted.P.value)), x = -log10(Adjusted.P.value))) +
geom_col(fill = scales::hue_pal()(5)[1]) +
labs(
x = "-Log10 Adjusted P value",
y = ""
) +
theme_classic() +
theme(legend.position = "none")Dot plot IGH chain genes (Figure 2E)
if (!file.exists("b_plasma_figure.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/b_plasma_figure.qs?download=1",
"b_plasma_figure.qs"
)
}
b_plasma_figure <- qread("b_plasma_figure.qs")
DotPlot(
b_plasma_figure,
features = c("IGHM", "IGHD", "IGHG1", "IGHG2", "IGHG3", "IGHG4", "IGHA1", "IGHA2"),
scale = FALSE,
dot.scale = 6
) +
viridis::scale_color_viridis(option = "viridis") +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5, face = "italic")) +
xlab("") +
ylab("") +
theme(
legend.text = element_text(size = 6),
legend.title = element_text(size = 10),
legend.key.size = unit(0.2, "cm")
)Scale for colour is already present.
Adding another scale for colour, which will replace the existing scale.
Figure 3
Propeller abundance PNP vs CTRL (Figure 3A)
if (!file.exists("propeller_PNP_CTRL.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/propeller_PNP_CTRL.qs?download=1",
"propeller_PNP_CTRL.qs"
)
}
if (!file.exists("propeller_PNP_CTRL_ic.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/propeller_PNP_CTRL_ic.qs?download=1",
"propeller_PNP_CTRL_ic.qs"
)
}
propeller_PNP_CTRL <- qread("propeller_PNP_CTRL.qs")
propeller_PNP_CTRL_ic <- qread("propeller_PNP_CTRL_ic.qs")
# function to plot custom dotplot
dotplotPropeller <- function(data, color, title) {
ggplot(data, aes(x = log2ratio, y = fct_reorder(cluster, log2ratio), color = cluster)) +
geom_point(size = 5) +
theme_classic() +
geom_vline(
xintercept = 0, color = "red",
linetype = "solid"
) +
scale_color_manual(values = color) +
xlab("Log2 fold change") +
ylab(NULL) +
theme(legend.position = "none") +
ggtitle(title)
}
dotplotPropeller(propeller_PNP_CTRL, color = umap_figure@misc$cluster_col, title = "PNP vs CTRL main clusters")dotplotPropeller(propeller_PNP_CTRL_ic, color = ic_figure@misc$ic_cluster_col, title = "PNP vs CTRL immune cells")Covarying Neighborhood Analysis (Figure 3B)
if (!file.exists("cna_pnp_gratio_figure.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/cna_pnp_gratio_figure.qs?download=1",
"cna_pnp_gratio_figure.qs"
)
}
if (!file.exists("cna_incat_figure.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/cna_incat_figure.qs?download=1",
"cna_incat_figure.qs"
)
}
cna_pnp_gratio_figure <- qread("cna_pnp_gratio_figure.qs")
cna_incat_figure <- qread("cna_incat_figure.qs")
# function to plot CNA feature plot
fplotCNA <- function(object, feature, title) {
FeaturePlot(
object,
reduction = "umap.scvi.full",
features = feature,
pt.size = 0.1,
order = FALSE,
coord.fixed = TRUE,
raster = FALSE,
alpha = 0.2
) +
scale_colour_gradient2(
low = "#2166AC",
mid = "white",
high = "#B2182B",
midpoint = 0,
) +
theme(
axis.text = element_blank(),
axis.ticks = element_blank(),
) +
labs(
title = title, color = "Correlation", x = "UMAP1", y= "UMAP2"
)
}
fplotCNA(cna_pnp_gratio_figure, "cna_ncorrs_pnp", title = "PNP")Scale for colour is already present.
Adding another scale for colour, which will replace the existing scale.
fplotCNA(cna_incat_figure, "cna_ncorrs", title = "INCAT")Scale for colour is already present.
Adding another scale for colour, which will replace the existing scale.
fplotCNA(cna_pnp_gratio_figure, "cna_ncorrs_gratio", title = "g-ratio")Scale for colour is already present.
Adding another scale for colour, which will replace the existing scale.
Number of DEGs (Figure 3C)
if (!file.exists("pnp_ctrl_pseudobulk_de.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/pnp_ctrl_pseudobulk_de.qs?download=1",
"pnp_ctrl_pseudobulk_de.qs"
)
}
pnp_ctrl_pseudobulk <- qread("pnp_ctrl_pseudobulk_de.qs")
pnp_ctrl_pseudobulk |>
mutate(cluster = fct_reorder(cluster, n)) |>
ggplot(aes(x = cluster, y = n, fill = cluster)) +
geom_col() +
coord_flip() +
scale_fill_manual(values = umap_figure@misc$cluster_col) +
theme_classic() +
theme(legend.position = "none") +
labs(
x = "",
y = "",
title = "PNP vs CTRL"
)MiloDE DEGs PNP vs CTRL (Figure 3D)
if (!file.exists("milo_figure.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/milo_figure.qs?download=1",
"milo_figure.qs"
)
}
milo_figure <- qread("milo_figure.qs")
plotMiloDE <- function(condition, title) {
plot <-
plot_milo_by_single_metric(
milo_figure$obj,
milo_figure$stat[[condition]],
colour_by = "n_DE_genes",
layout = "UMAP.SCVI.FULL",
size_range = c(0.5, 5),
edge_width = c(0.1, 1.0),
edge_weight.thres = 10
) +
viridis::scale_fill_viridis(name = "# DE genes", option = "inferno") +
ggtitle(title)
print(plot)
}
plotMiloDE("pnp", "PNP vs CTRL")Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
Pseudobulk DE PNP vs CTRL (Figure 3E)
if (!file.exists("de_pseudo_pnp_ctrl.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/de_pseudo_pnp_ctrl.qs?download=1",
"de_pseudo_pnp_ctrl.qs"
)
}
de_pseudo_pnp_ctrl <- qread("de_pseudo_pnp_ctrl.qs")
# volcano plot function
volcanoPlot <- function(cluster, input, FCcutoff = 2, selectLab = NULL, drawConnectors = TRUE, condition1, condition2) {
input <- input[[cluster]]
volcano <- EnhancedVolcano::EnhancedVolcano(
data.frame(input),
lab = paste0("italic('", input[["gene"]], "')"),
x = "avg_logFC",
y = "p_val_adj",
xlim = c(min(input[["avg_logFC"]], max(input[["avg_logFC"]]))),
ylim = c(0, max(-log10(input[["p_val_adj"]]))),
pCutoff = 0.1,
FCcutoff = FCcutoff,
axisLabSize = 15,
pointSize = 2,
labSize = 5,
subtitle = NULL,
caption = NULL,
border = "full",
gridlines.major = FALSE,
gridlines.minor = FALSE,
drawConnectors = drawConnectors,
lengthConnectors = unit(0.0001, "npc"),
title = paste(condition1, "vs", condition2, "in ", cluster),
boxedLabels = TRUE,
selectLab = selectLab,
xlab = bquote(~ Log[2] ~ "fold change"),
ylab = bquote(~ -Log[10] ~ "adjusted p-value"),
parseLabels = TRUE,
legendLabels = c(
"NS", "logFC",
"p-val", "p-val + logFC"
),
legendPosition = "right",
)
}
# define clusters of interest
cluster_de <- c("mySC", "nmSC", "repairSC", "PC2")
# define genes of interests
lab_pnp_ctrl <- list(
"mySC" = paste0("italic('", c("DCN", "TNXB", "COL1A1", "COL15A1", "CD53", "IL4R", "CD74"), "')"),
"nmSC" = paste0("italic('", c("IL10RA", "IL13RA1", "CSF2RA", "TGFBI"), "')"),
"repairSC" = paste0("italic('", c("GALR1", "TMEM47"), "')"),
"PC2" = paste0("italic('", c("MFAP5", "NLGN4Y", "PCDH11Y", "IFIT3", "OASL", "MX1"), "')")
)
# plot volcano plots of selected clusters
purrr::walk(
cluster_de,
function(cluster) {
print(volcanoPlot(
cluster = cluster,
input = de_pseudo_pnp_ctrl,
FCcutoff = 2,
condition1 = "PNP",
condition2 = "CTRL",
selectLab = lab_pnp_ctrl[[cluster]]
))
}
)Figure 4
Abundance of clusters per PNP subtype (Figure 4A)
if (!file.exists("abundance_main_clusters.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/abundance_main_clusters.qs?download=1",
"abundance_main_clusters.qs"
)
}
abundance_main_clusters <- qread("abundance_main_clusters.qs")
abundance_main_clusters |>
ggplot() +
geom_col(
aes(x = type, y = count, fill = cell),
color = "black",
linewidth = 0.1,
position = "fill"
) +
scale_fill_manual(values = umap_figure@misc$cluster_col) +
guides(fill = guide_legend(title = NULL)) +
theme_classic() +
ylab("Proportion of cells") +
xlab("") +
theme(axis.text.x = element_text(
angle = 90,
hjust = 1, vjust = 0.3
))Propeller abundance of PNP subtypes main cluster (Figure 4B)
if (!file.exists("propeller_PNP_subtypes_main.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/propeller_PNP_subtypes_main.qs?download=1",
"propeller_PNP_subtypes_main.qs"
)
}
propeller_PNP_subtypes_main <- qread("propeller_PNP_subtypes_main.qs")
purrr::walk(
c("VN", "CIDP", "CIAP"),
function(condition) {
print(dotplotPropeller(
propeller_PNP_subtypes_main[[condition]],
color = umap_figure@misc$cluster_col,
title = paste0("CTRL vs ", condition, " main")
))
}
)Propeller abundance of PNP subtypes immune cluster (Figure 4C)
if (!file.exists("propeller_PNP_subtypes_ic.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/propeller_PNP_subtypes_ic.qs?download=1",
"propeller_PNP_subtypes_ic.qs"
)
}
propeller_PNP_subtypes_ic <- qread("propeller_PNP_subtypes_ic.qs")
purrr::walk(
c("VN", "CIDP", "CIAP"),
function(condition) {
print(dotplotPropeller(
propeller_PNP_subtypes_ic[[condition]],
color = umap_figure@misc$cluster_col,
title = paste0("CTRL vs ", condition, " immune")
))
}
)Manual PTPRC quantification in Xenium (Figure 4F)
if (!file.exists("manual_xenium_quantification.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/manual_xenium_quantification.qs?download=1",
"manual_xenium_quantification.qs"
)
}
manual_xenium_quantification <- qread("manual_xenium_quantification.qs")
plotQuanti <- function(y_value, title) {
plot <-
manual_xenium_quantification |>
ggplot(aes(x = level2, y = .data[[y_value]], fill = level2)) +
geom_boxplot() +
geom_jitter(height = 0, width = 0.1) +
scale_fill_manual(values = umap_figure@misc$level2_cols) +
guides(fill = guide_legend(title = NULL)) +
theme_classic() +
xlab("") +
ylab("") +
ggtitle(title) +
theme(
legend.position = "none",
axis.text.x = element_text(
angle = 90,
hjust = 1,
vjust = 0.3,
)
)
print(plot)
}
purrr::walk2(
c("endoPTPRC_density_sum", "epiPTPRC_density"),
c("PTPRC density endoneurial", "PTPRC density epineurial"),
function(y_value, title) {
plotQuanti(y_value = y_value, title = title)
}
)MiloDE DEGs PNP subtypes(Figure 4G)
purrr::walk2(
c("vn", "cidp", "ciap"),
c("VN vs CTRL", "CIDP vs CTRL", "CIAP vs CTRL"),
function(condition, title) {
plotMiloDE(condition, title)
}
)Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
Scale for fill is already present.
Adding another scale for fill, which will replace the existing scale.
Supplementary Figure 1
Demographics plot (Figure S1A)
if (!file.exists("demographics.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/demographics.qs?download=1",
"demographics.qs"
)
}
demographics <- qread("demographics.qs")
plotDemographics <- function(var) {
plot <- demographics |>
dplyr::filter(!is.na(.data[[var]])) |>
ggplot(aes(x = level2, y = .data[[var]], fill = level2)) +
geom_boxplot() +
geom_point() +
theme_bw() +
scale_fill_manual(values = umap_figure@misc$level2_cols) +
xlab("") +
ylab("") +
ggtitle(var) +
theme(legend.position = "none")
print(plot)
}
purrr::walk(c("age", "ncv_tibial_motoric", "incat"), plotDemographics)demographics |>
ggplot(aes(x = level2, fill = sex)) +
geom_bar() +
theme_bw() +
scale_fill_manual(values = pals::cols25(2)) +
xlab("") +
ylab("") +
ggtitle("sex")UMAP grouped by center and sample (Figure S1C)
DimPlot(
umap_figure,
reduction = "umap.scvi.full",
pt.size = .1,
raster = FALSE,
alpha = 0.1,
group.by = "center",
cols = pals::cols25(3),
label = FALSE
) +
theme(
axis.text = element_blank(),
axis.ticks = element_blank()
) +
xlab("UMAP_1") +
ylab("UMAP_2")my_cols_50 <- unname(Polychrome::createPalette(50, pals::cols25()))
DimPlot(
umap_figure,
reduction = "umap.scvi.full",
pt.size = .1,
raster = FALSE,
alpha = 0.1,
group.by = "sample",
cols = umap_figure@misc$sample_cols,
label = FALSE
) +
theme(
axis.text = element_blank(),
axis.ticks = element_blank()
) +
xlab("UMAP_1") +
ylab("UMAP_2")Number of genes per nucleus (Figure S1D)
count_genes <- dplyr::tibble(
feature = umap_figure@meta.data$nFeature_RNA,
sample = umap_figure@meta.data$sample
)
count_genes |>
ggplot(aes(x = sample, y = feature, fill = sample)) +
geom_boxplot() +
scale_fill_manual(values = umap_figure@misc$sample_cols) +
theme_classic() +
theme(legend.position = "none") +
xlab("") +
ylab("") +
ggtitle("Number of genes per nucleus") +
theme(axis.text.x = element_text(angle = 90))Abundance of clusters per sample (Figure S1E)
if (!file.exists("abundance_main_clusters_sample.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/abundance_main_clusters_sample.qs?download=1",
"abundance_main_clusters_sample.qs"
)
}
abundance_main_clusters_sample <- qread("abundance_main_clusters_sample.qs")
abundance_main_clusters_sample |>
mutate(type = factor(type, levels = rev(levels(factor(type))))) |>
ggplot() +
geom_col(
aes(x = type, y = count, fill = cell),
color = "black",
linewidth = 0.1,
position = "fill"
) +
scale_fill_manual(values = umap_figure@misc$cluster_col) +
theme_classic() +
ylab("Proportion of cells") +
xlab("") +
theme(
axis.text.x = element_text(
angle = 90,
hjust = 1, vjust = 0.3
),
legend.position = "none"
) +
coord_flip()Supplementary Figure 2
Dotplot of main clusters(Figure S2A)
if (!file.exists("dotplot_data.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/dotplot_data.qs?download=1",
"dotplot_data.qs"
)
}
dotplot_data <- qread("dotplot_data.qs")
# Seurat DotPlot function (only ggplot part to avoid calculations)
DotPlotModified <- function(
data.plot,
cols = c("lightgrey", "blue"),
dot.scale = 6,
scale.by = 'radius',
scale.min = NA,
scale.max = NA
) {
scale.func <- switch(
EXPR = scale.by,
'size' = scale_size,
'radius' = scale_radius,
stop("'scale.by' must be either 'size' or 'radius'")
)
color.by <- 'avg.exp.scaled'
plot <- ggplot(data = data.plot, mapping = aes_string(x = 'features.plot', y = 'id')) +
geom_point(mapping = aes_string(size = 'pct.exp', color = color.by)) +
scale.func(range = c(0, dot.scale), limits = c(scale.min, scale.max)) +
theme(axis.title.x = element_blank(), axis.title.y = element_blank()) +
guides(size = guide_legend(title = 'Percent Expressed')) +
cowplot::theme_cowplot()
plot <- plot + guides(color = guide_colorbar(title = 'Average Expression'))
return(plot)
}
DotPlotModified(
data.plot = dotplot_data,
scale.by = "size"
) +
viridis::scale_color_viridis(option = "viridis") +
theme(axis.text.x = element_text(
angle = 90,
vjust = 0.5,
hjust = 1,
face = "italic",
size = 7
),
legend.position = "top",
legend.text = element_text(size = 6),
legend.title = element_text(size = 10)
) +
xlab("") +
ylab("")Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
ℹ Please use tidy evaluation idioms with `aes()`.
ℹ See also `vignette("ggplot2-in-packages")` for more information.
Warning: Removed 688 rows containing missing values or values outside the scale range
(`geom_point()`).
Enrichment of gene ontology terms of markers genes in periC (Figure S2B)
if (!file.exists("enrichr_periC.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/enrichr_periC.qs?download=1",
"enrichr_periC.qs"
)
}
enrichr_periC <- qread("enrichr_periC.qs")
plotEnrichr <- function(data, name) {
plot <-
data |>
dplyr::slice_min(order_by = Adjusted.P.value, n = 10, with_ties = FALSE) |>
tidyr::separate(Overlap, into = c("overlap1", "overlap2")) |>
dplyr::mutate(Term = gsub(x = Term, pattern = "\\s\\(.+\\)", replacement = "")) |>
dplyr::mutate(overlap = as.numeric(overlap1) / as.numeric(overlap2)) |>
ggplot(aes(y = reorder(Term, -log10(Adjusted.P.value)), x = -log10(Adjusted.P.value))) +
geom_col(fill = scales::hue_pal()(5)[1]) +
labs(
x = "-Log10 Adjusted P value",
y = ""
) +
theme_classic() +
theme(legend.position = "none") +
ggtitle(name)
print(plot)
}
purrr::walk2(
enrichr_periC,
names(enrichr_periC),
plotEnrichr
)plotUMAP <- function(group, title) {
plot <-
DimPlot(
umap_figure,
reduction = "umap.scvi.full",
group.by = group,
raster = FALSE,
pt.size = .1,
alpha = .1,
cols = umap_figure@misc$sample_cols,
label = TRUE
) +
theme(
axis.text = element_blank(),
axis.ticks = element_blank()
) +
xlab("UMAP_1") +
ylab("UMAP_2") +
NoLegend() +
ggtitle(title)
print(plot)
}
purrr::walk2(
c("milbrandt_sciatic_label_full", "suter_p60_label_full"),
c("Yim et al. sciatic nerve", "Gerber et al. p60"),
plotUMAP
)if (!file.exists("ec_rosmap.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/ec_rosmap.qs?download=1",
"ec_rosmap.qs"
)
}
ec_rosmap <- qread("ec_rosmap.qs")
DimPlot(
ec_rosmap,
reduction = "umap.scvi.full",
group.by = "rosmap_label",
raster = FALSE,
pt.size = .1,
alpha = .1,
cols = ec_rosmap@misc$sample_cols,
label = TRUE
) +
NoLegend() +
xlim(-12, -5) +
ylim(2, 10) +
xlab("UMAP_1") +
ylab("UMAP_2") +
ggtitle("ROSMAP vascular cells") +
theme(
axis.text = element_blank(),
axis.ticks = element_blank()
)Warning: Removed 53 rows containing missing values or values outside the scale range
(`geom_point()`).
Dotplot of new marker genes in rodent and human datasets (Figure S2D)
if (!file.exists("dotplot_human_rodent.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/dotplot_human_rodent.qs?download=1",
"dotplot_human_rodent.qs"
)
}
dotplot_human_rodent <- qread("dotplot_human_rodent.qs")
DotPlotCustom <-
function(data, title) {
plot <-
DotPlotModified(
data.plot = data,
scale.by = "size",
dot.scale = 10,
) +
viridis::scale_color_viridis(option = "viridis") +
theme(axis.text.x = element_text(
angle = 90,
vjust = 0.5,
hjust = 1,
face = "italic",
)) +
xlab("") +
ylab("") +
ggtitle(title)
print(plot)
}
purrr::walk2(
dotplot_human_rodent,
c("rodent(Yim et al.)", "human (this study)"),
DotPlotCustom
)Warning: Removed 9 rows containing missing values or values outside the scale range
(`geom_point()`).
Warning: Removed 6 rows containing missing values or values outside the scale range
(`geom_point()`).
Supplementary Figure 4
Dotplot of immune cell marker genes (Figure S4A)
if (!file.exists("dotplot_data_ic.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/dotplot_data_ic.qs?download=1",
"dotplot_data_ic.qs"
)
}
dotplot_data_ic <- qread("dotplot_data_ic.qs")
DotPlotModified(
data.plot = dotplot_data_ic,
scale.by = "size"
) +
viridis::scale_color_viridis(option = "viridis") +
theme(axis.text.x = element_text(
angle = 90,
vjust = 0.5,
hjust = 1,
face = "italic",
size = 7
),
legend.position = "top",
legend.text = element_text(size = 6),
legend.title = element_text(size = 10)
) +
xlab("") +
ylab("")Warning: Removed 967 rows containing missing values or values outside the scale range
(`geom_point()`).
Enrichment of gene ontology terms in DEG (Figure S4B)
if (!file.exists("enrichr_de.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/enrichr_de.qs?download=1",
"enrichr_de.qs"
)
}
enrichr_de <- qread("enrichr_de.qs")
purrr::walk2(
enrichr_de$pos,
paste0(names(enrichr_de$pos), " upregulated in PNP"),
plotEnrichr
)purrr::walk2(
enrichr_de$neg,
paste0(names(enrichr_de$neg), " downregulated in PNP"),
plotEnrichr
)Supplementary Figure 5
Boxplots of g-ratio per sample (Figure S5B)
if (!file.exists("g_ratio.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/g_ratio.qs?download=1",
"g_ratio.qs"
)
}
g_ratio <- qread("g_ratio.qs")
g_ratio |>
ggplot(aes(x = sample, y = g_ratio)) +
geom_boxplot() +
geom_jitter(height = 0, width = 0.1, alpha = 0.3, size = 0.1) +
theme_bw() +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) +
xlab("g-ratio") +
ylab("")Boxplots of g-ratio per PNP subtye (Figure S5C)
# function to plot boxplots Figure S5C-E
plotBoxplotCustom <-
function(data, y_var) {
data |>
ggplot(aes(x = level2, y = .data[[y_var]], fill = level2)) +
geom_boxplot() +
geom_jitter(height = 0, width = 0.1) +
scale_fill_manual(values = umap_figure@misc$level2_cols) +
theme_classic() +
ylab(y_var) +
xlab("") +
theme(
axis.text.x = element_text(
angle = 90,
hjust = 1,
vjust = 0.3
),
legend.position = "none"
)
}
g_ratio |>
group_by(sample) |>
mutate(g_ratio = mean(g_ratio)) |>
select(sample, level2, g_ratio) |>
distinct() |>
plotBoxplotCustom(y_var = "g_ratio")Boxplots of axon count per PNP subtype (Figure S5D)
if (!file.exists("axon_count.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/axon_count.qs?download=1",
"axon_count.qs"
)
}
axon_count <- qread("axon_count.qs")
plotBoxplotCustom(data = axon_count, y_var = "axon_count")Boxplots of axon diameter per PNP subtype (Figure S5E)
g_ratio_grouped <-
g_ratio |>
group_by(sample) |>
mutate(
g_ratio = mean(g_ratio),
ncv_tibial_motoric = mean(ncv_tibial_motoric),
axon_diameter = mean(axon_diameter)
) |>
ungroup() |>
select(sample, level2, g_ratio, ncv_tibial_motoric, axon_diameter) |>
distinct()
plotBoxplotCustom(g_ratio_grouped, y_var = "axon_diameter")Correlation plots of NCV and histological measures (Figure S5F)
plotCor <- function(data, x, y) {
ggplot(data, aes(x = .data[[x]], y = .data[[y]])) +
geom_point() +
geom_smooth(method = "lm") +
theme_bw() +
xlab(x) +
ylab(y)
}
plotCor(g_ratio_grouped, x = "ncv_tibial_motoric", y = "g_ratio")`geom_smooth()` using formula = 'y ~ x'
Warning: Removed 12 rows containing non-finite outside the scale range
(`stat_smooth()`).
Warning: Removed 12 rows containing missing values or values outside the scale range
(`geom_point()`).
plotCor(axon_count, x = "ncv_tibial_motoric", y = "axon_count")`geom_smooth()` using formula = 'y ~ x'
Warning: Removed 12 rows containing non-finite outside the scale range
(`stat_smooth()`).
Removed 12 rows containing missing values or values outside the scale range
(`geom_point()`).
plotCor(g_ratio_grouped, x = "ncv_tibial_motoric", y = "axon_diameter")`geom_smooth()` using formula = 'y ~ x'
Warning: Removed 12 rows containing non-finite outside the scale range
(`stat_smooth()`).
Removed 12 rows containing missing values or values outside the scale range
(`geom_point()`).
Correlation plots of axon count and SC abundance (Figure S5G)
if(!file.exists("abundance_axon.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/abundance_axon.qs?download=1",
"abundance_axon.qs"
)
}
abundance_axon <- qread("abundance_axon.qs")
abundance_axon |>
dplyr::filter(cell == "mySC") |>
plotCor(x = "log_axon_normal", y = "count") +
ylab("mySC (%)")`geom_smooth()` using formula = 'y ~ x'
abundance_axon |>
dplyr::filter(cell == "repairSC") |>
plotCor(x = "log_axon_normal", y = "count") +
ylab("repairSC (%)")`geom_smooth()` using formula = 'y ~ x'
Quantification of predicted cluster abundance in Xenium (Figure S5I+M)
if(!file.exists("xenium_sc_t_nk.qs")) {
download.file(
"https://zenodo.org/records/14551660/files/xenium_sc_t_nk.qs?download=1",
"xenium_sc_t_nk.qs"
)
}
xenium_sc_t_nk <- qread("xenium_sc_t_nk.qs")
xenium_sc_t_nk |>
ggplot(aes(x = condition, y = percent, fill = condition)) +
geom_boxplot() +
geom_point() +
theme_classic() +
facet_wrap(vars(cluster), scales = "free_y", nrow = 1) +
theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.3)) +
xlab("") +
ylab("percentage") +
scale_fill_manual(values = umap_figure@misc$level2_cols) +
theme(legend.position = "none")Manual CD3E quantification in Xenium (Figure S5J)
purrr::walk2(
c("endoCD3E_density_sum", "epiCD3E_density"),
c("CD3E density endoneurial", "CD3E density epineurial"),
plotQuanti
)Manual MS4A1 quantification in Xenium (Figure S5K)
purrr::walk2(
c("endoMS4A1_density_sum", "epiMS4A1_density"),
c("MS4A1 density endoneurial", "MS4A1 density epineurial"),
plotQuanti
)Session info
session_info()─ Session info ───────────────────────────────────────────────────────────────
setting value
version R version 4.3.1 (2023-06-16)
os Ubuntu 24.04.2 LTS
system x86_64, linux-gnu
ui X11
language (EN)
collate en_US.UTF-8
ctype en_US.UTF-8
tz Europe/Berlin
date 2025-03-28
pandoc 3.1.3 @ /usr/bin/ (via rmarkdown)
─ Packages ───────────────────────────────────────────────────────────────────
package * version date (UTC) lib source
abind 1.4-5 2016-07-21 [1] RSPM (R 4.3.0)
Augur 1.0.3 2024-04-05 [1] Github (neurorestore/Augur@fa5d837)
backports 1.4.1 2021-12-13 [1] RSPM (R 4.3.0)
beachmat 2.18.0 2023-10-24 [1] Bioconductor
beeswarm 0.4.0 2021-06-01 [1] RSPM (R 4.3.0)
Biobase 2.62.0 2023-10-24 [1] Bioconductor
BiocGenerics 0.48.1 2023-11-01 [1] Bioconductor
BiocNeighbors 1.20.2 2024-01-07 [1] Bioconductor 3.18 (R 4.3.1)
BiocParallel 1.36.0 2023-10-24 [1] Bioconductor
BiocSingular 1.18.0 2023-10-24 [1] Bioconductor
bitops 1.0-7 2021-04-24 [1] RSPM (R 4.3.0)
broom 1.0.5 2023-06-09 [1] RSPM (R 4.3.0)
car 3.1-2 2023-03-30 [1] RSPM (R 4.3.0)
carData 3.0-5 2022-01-06 [1] RSPM (R 4.3.0)
class 7.3-22 2023-05-03 [1] RSPM (R 4.3.0)
cli 3.6.2 2023-12-11 [1] RSPM (R 4.3.0)
cluster 2.1.6 2023-12-01 [1] RSPM (R 4.3.0)
codetools 0.2-19 2023-02-01 [1] CRAN (R 4.2.2)
colorspace 2.1-0 2023-01-23 [1] RSPM (R 4.3.0)
cowplot 1.1.2 2023-12-15 [1] RSPM (R 4.3.0)
crayon 1.5.2 2022-09-29 [1] RSPM (R 4.3.0)
data.table 1.14.10 2023-12-08 [1] RSPM (R 4.3.0)
DelayedArray 0.28.0 2023-10-24 [1] Bioconductor
DelayedMatrixStats 1.24.0 2023-10-24 [1] Bioconductor
deldir 2.0-2 2023-11-23 [1] RSPM (R 4.3.0)
dichromat 2.0-0.1 2022-05-02 [1] RSPM (R 4.3.0)
digest 0.6.34 2024-01-11 [1] RSPM (R 4.3.0)
dotCall64 1.1-1 2023-11-28 [1] RSPM (R 4.3.0)
dplyr * 1.1.4 2023-11-17 [1] RSPM (R 4.3.0)
edgeR 4.0.7 2024-01-12 [1] Bioconductor 3.18 (R 4.3.1)
ellipsis 0.3.2 2021-04-29 [1] RSPM (R 4.3.0)
EnhancedVolcano * 1.20.0 2023-10-24 [1] Bioconductor
evaluate 0.23 2023-11-01 [1] RSPM (R 4.3.0)
fansi 1.0.6 2023-12-08 [1] RSPM (R 4.3.0)
farver 2.1.1 2022-07-06 [1] RSPM (R 4.3.0)
fastDummies 1.7.3 2023-07-06 [1] RSPM (R 4.3.0)
fastmap 1.1.1 2023-02-24 [1] RSPM (R 4.3.0)
fitdistrplus 1.1-11 2023-04-25 [1] RSPM (R 4.3.0)
forcats * 1.0.0 2023-01-29 [1] RSPM (R 4.3.0)
furrr 0.3.1 2022-08-15 [1] RSPM (R 4.3.0)
future 1.33.1 2023-12-22 [1] RSPM (R 4.3.0)
future.apply 1.11.1 2023-12-21 [1] RSPM (R 4.3.0)
generics 0.1.3 2022-07-05 [1] RSPM (R 4.3.0)
GenomeInfoDb 1.38.5 2023-12-28 [1] Bioconductor 3.18 (R 4.3.1)
GenomeInfoDbData 1.2.11 2023-11-13 [1] Bioconductor
GenomicRanges 1.54.1 2023-10-29 [1] Bioconductor
ggbeeswarm 0.7.2 2023-04-29 [1] RSPM (R 4.3.0)
ggforce 0.4.1 2022-10-04 [1] RSPM (R 4.3.0)
ggplot2 * 3.5.1 2024-04-23 [1] RSPM (R 4.3.0)
ggpubr 0.6.0 2023-02-10 [1] RSPM (R 4.3.0)
ggraph 2.1.0 2022-10-09 [1] RSPM (R 4.3.0)
ggrepel * 0.9.5 2024-01-10 [1] RSPM (R 4.3.0)
ggridges 0.5.5 2023-12-15 [1] RSPM (R 4.3.0)
ggsignif 0.6.4 2022-10-13 [1] RSPM (R 4.3.0)
globals 0.16.2 2022-11-21 [1] RSPM (R 4.3.0)
glue 1.7.0 2024-01-09 [1] RSPM (R 4.3.0)
goftest 1.2-3 2021-10-07 [1] RSPM (R 4.3.0)
gower 1.0.1 2022-12-22 [1] RSPM (R 4.3.0)
graphlayouts 1.0.2 2023-11-03 [1] RSPM (R 4.3.0)
gridExtra 2.3 2017-09-09 [1] RSPM (R 4.3.0)
gtable 0.3.4 2023-08-21 [1] RSPM (R 4.3.0)
gtools 3.9.5 2023-11-20 [1] RSPM (R 4.3.0)
hardhat 1.3.0 2023-03-30 [1] RSPM (R 4.3.0)
hms 1.1.3 2023-03-21 [1] RSPM (R 4.3.0)
htmltools 0.5.7 2023-11-03 [1] RSPM (R 4.3.0)
htmlwidgets 1.6.4 2023-12-06 [1] RSPM (R 4.3.0)
httpuv 1.6.13 2023-12-06 [1] RSPM (R 4.3.0)
httr 1.4.7 2023-08-15 [1] RSPM (R 4.3.0)
ica 1.0-3 2022-07-08 [1] RSPM (R 4.3.0)
igraph 1.6.0 2023-12-11 [1] RSPM (R 4.3.0)
ipred 0.9-14 2023-03-09 [1] RSPM (R 4.3.0)
IRanges 2.36.0 2023-10-24 [1] Bioconductor
irlba 2.3.5.1 2022-10-03 [1] RSPM (R 4.3.0)
jsonlite 1.8.9 2024-09-20 [1] CRAN (R 4.3.1)
KernSmooth 2.23-22 2023-07-10 [1] RSPM (R 4.3.0)
knitr 1.45 2023-10-30 [1] RSPM (R 4.3.0)
labeling 0.4.3 2023-08-29 [1] RSPM (R 4.3.0)
later 1.3.2 2023-12-06 [1] RSPM (R 4.3.0)
lattice 0.22-5 2023-10-24 [1] RSPM (R 4.3.0)
lava 1.7.3 2023-11-04 [1] RSPM (R 4.3.0)
lazyeval 0.2.2 2019-03-15 [1] RSPM (R 4.3.0)
leiden 0.4.3.1 2023-11-17 [1] RSPM (R 4.3.0)
lifecycle 1.0.4 2023-11-07 [1] RSPM (R 4.3.0)
limma 3.58.1 2023-10-31 [1] Bioconductor
listenv 0.9.0 2022-12-16 [1] RSPM (R 4.3.0)
lmtest 0.9-40 2022-03-21 [1] RSPM (R 4.3.0)
locfit 1.5-9.8 2023-06-11 [1] RSPM (R 4.3.0)
lubridate * 1.9.3 2023-09-27 [1] RSPM (R 4.3.0)
magrittr 2.0.3 2022-03-30 [1] RSPM (R 4.3.0)
mapproj 1.2.11 2023-01-12 [1] RSPM (R 4.3.0)
maps 3.4.2 2023-12-15 [1] RSPM (R 4.3.0)
MASS 7.3-60 2023-05-04 [1] RSPM (R 4.3.0)
Matrix 1.6-5 2024-01-11 [1] RSPM (R 4.3.0)
MatrixGenerics 1.15.0 2024-04-05 [1] Github (Bioconductor/MatrixGenerics@ed066a2)
matrixStats 1.2.0 2023-12-11 [1] RSPM (R 4.3.0)
mgcv 1.9-1 2023-12-21 [1] RSPM (R 4.3.0)
miloDE * 0.0.0.9000 2024-04-05 [1] Github (MarioniLab/milODE@3f825b9)
miloR 1.10.0 2023-10-24 [1] Bioconductor
mime 0.12 2021-09-28 [1] RSPM (R 4.3.0)
miniUI 0.1.1.1 2018-05-18 [1] RSPM (R 4.3.0)
munsell 0.5.0 2018-06-12 [1] RSPM (R 4.3.0)
nlme 3.1-164 2023-11-27 [1] RSPM (R 4.3.0)
nnet 7.3-19 2023-05-03 [1] RSPM (R 4.3.0)
pals * 1.8 2023-08-23 [1] RSPM (R 4.3.0)
parallelly 1.36.0 2023-05-26 [1] RSPM (R 4.3.0)
parsnip 1.1.1 2023-08-17 [1] RSPM (R 4.3.0)
patchwork 1.2.0 2024-01-08 [1] RSPM (R 4.3.0)
pbapply 1.7-2 2023-06-27 [1] RSPM (R 4.3.0)
pbmcapply 1.5.1 2022-04-28 [1] RSPM (R 4.3.0)
pillar 1.9.0 2023-03-22 [1] RSPM (R 4.3.0)
pkgconfig 2.0.3 2019-09-22 [1] RSPM (R 4.3.0)
plotly 4.10.3 2023-10-21 [1] RSPM (R 4.3.0)
plyr 1.8.9 2023-10-02 [1] RSPM (R 4.3.0)
png 0.1-8 2022-11-29 [1] RSPM (R 4.3.0)
Polychrome 1.5.1 2022-05-03 [1] RSPM (R 4.3.0)
polyclip 1.10-6 2023-09-27 [1] RSPM (R 4.3.0)
prodlim 2023.08.28 2023-08-28 [1] RSPM (R 4.3.0)
progressr 0.14.0 2023-08-10 [1] RSPM (R 4.3.0)
promises 1.2.1 2023-08-10 [1] RSPM (R 4.3.0)
purrr * 1.0.2 2023-08-10 [1] RSPM (R 4.3.0)
qs * 0.25.7 2023-12-06 [1] RSPM (R 4.3.0)
R6 2.5.1 2021-08-19 [1] RSPM (R 4.3.0)
randomForest 4.7-1.1 2022-05-23 [1] RSPM (R 4.3.0)
RANN 2.6.1 2019-01-08 [1] RSPM (R 4.3.0)
RApiSerialize 0.1.2 2022-08-25 [1] RSPM (R 4.3.0)
RColorBrewer 1.1-3 2022-04-03 [1] RSPM (R 4.3.0)
Rcpp 1.0.12 2024-01-09 [1] RSPM (R 4.3.0)
RcppAnnoy 0.0.21 2023-07-02 [1] RSPM (R 4.3.0)
RcppGreedySetCover 0.1.0 2018-01-24 [1] RSPM (R 4.3.0)
RcppHNSW 0.5.0 2023-09-19 [1] RSPM (R 4.3.0)
RcppParallel 5.1.7 2023-02-27 [1] RSPM (R 4.3.0)
RCurl 1.98-1.14 2024-01-09 [1] RSPM (R 4.3.0)
readr * 2.1.5 2024-01-10 [1] RSPM (R 4.3.0)
recipes 1.0.9 2023-12-13 [1] RSPM (R 4.3.0)
reshape2 1.4.4 2020-04-09 [1] RSPM (R 4.3.0)
reticulate 1.34.0 2023-10-12 [1] RSPM (R 4.3.0)
rlang 1.1.3 2024-01-10 [1] RSPM (R 4.3.0)
rmarkdown 2.25 2023-09-18 [1] RSPM (R 4.3.0)
ROCR 1.0-11 2020-05-02 [1] RSPM (R 4.3.0)
rpart 4.1.23 2023-12-05 [1] RSPM (R 4.3.0)
rsample 1.2.0 2023-08-23 [1] RSPM (R 4.3.0)
RSpectra 0.16-1 2022-04-24 [1] RSPM (R 4.3.0)
rstatix 0.7.2 2023-02-01 [1] RSPM (R 4.3.0)
rsvd 1.0.5 2021-04-16 [1] RSPM (R 4.3.0)
Rtsne 0.17 2023-12-07 [1] RSPM (R 4.3.0)
S4Arrays 1.2.0 2023-10-24 [1] Bioconductor
S4Vectors 0.40.2 2023-11-23 [1] Bioconductor 3.18 (R 4.3.1)
ScaledMatrix 1.10.0 2023-10-24 [1] Bioconductor
scales 1.3.0 2023-11-28 [1] RSPM (R 4.3.0)
scattermore 1.2 2023-06-12 [1] RSPM (R 4.3.0)
scatterplot3d 0.3-44 2023-05-05 [1] RSPM (R 4.3.0)
scMisc * 0.3.0 2024-04-01 [1] Github (mihem/scMisc@6b1e979)
sctransform 0.4.1 2023-10-19 [1] RSPM (R 4.3.0)
scuttle 1.12.0 2023-10-24 [1] Bioconductor
sessioninfo * 1.2.2 2021-12-06 [1] RSPM (R 4.3.0)
Seurat * 5.0.1 2024-01-14 [1] Github (fentouxungui/seurat@d2d8d60)
SeuratObject * 5.0.1 2023-11-17 [1] CRAN (R 4.3.1)
shiny 1.8.0 2023-11-17 [1] RSPM (R 4.3.0)
SingleCellExperiment 1.24.0 2023-10-24 [1] Bioconductor
sp * 2.1-2 2023-11-26 [1] RSPM (R 4.3.0)
spam 2.10-0 2023-10-23 [1] RSPM (R 4.3.0)
SparseArray 1.2.3 2023-12-25 [1] Bioconductor 3.18 (R 4.3.1)
sparseMatrixStats 1.13.4 2024-04-05 [1] Github (const-ae/sparseMatrixStats@4c6e814)
spatstat.data 3.0-3 2023-10-24 [1] RSPM (R 4.3.0)
spatstat.explore 3.2-5 2023-10-22 [1] RSPM (R 4.3.0)
spatstat.geom 3.2-7 2023-10-20 [1] RSPM (R 4.3.0)
spatstat.random 3.2-2 2023-11-29 [1] RSPM (R 4.3.0)
spatstat.sparse 3.0-3 2023-10-24 [1] RSPM (R 4.3.0)
spatstat.utils 3.0-4 2023-10-24 [1] RSPM (R 4.3.0)
statmod 1.5.0 2023-01-06 [1] RSPM (R 4.3.0)
stringfish 0.16.0 2023-11-28 [1] RSPM (R 4.3.0)
stringi 1.8.3 2023-12-11 [1] RSPM (R 4.3.0)
stringr * 1.5.1 2023-11-14 [1] RSPM (R 4.3.0)
SummarizedExperiment 1.32.0 2023-10-24 [1] Bioconductor
survival 3.5-7 2023-08-14 [1] RSPM (R 4.3.0)
tensor 1.5 2012-05-05 [1] RSPM (R 4.3.0)
tester 0.1.7 2013-11-14 [1] RSPM (R 4.3.0)
tibble * 3.2.1 2023-03-20 [1] RSPM (R 4.3.0)
tidygraph 1.3.0 2023-12-18 [1] RSPM (R 4.3.0)
tidyr * 1.3.0 2023-01-24 [1] RSPM (R 4.3.0)
tidyselect 1.2.0 2022-10-10 [1] RSPM (R 4.3.0)
tidyverse * 2.0.0 2023-02-22 [1] RSPM (R 4.3.0)
timechange 0.2.0 2023-01-11 [1] RSPM (R 4.3.0)
timeDate 4032.109 2023-12-14 [1] RSPM (R 4.3.0)
tweenr 2.0.2 2022-09-06 [1] RSPM (R 4.3.0)
tzdb 0.4.0 2023-05-12 [1] RSPM (R 4.3.0)
utf8 1.2.4 2023-10-22 [1] RSPM (R 4.3.0)
uwot 0.1.16 2023-06-29 [1] RSPM (R 4.3.0)
vctrs 0.6.5 2023-12-01 [1] RSPM (R 4.3.0)
vipor 0.4.7 2023-12-18 [1] RSPM (R 4.3.0)
viridis 0.6.4 2023-07-22 [1] RSPM (R 4.3.0)
viridisLite 0.4.2 2023-05-02 [1] RSPM (R 4.3.0)
withr 2.5.2 2023-10-30 [1] RSPM (R 4.3.0)
xfun 0.41 2023-11-01 [1] RSPM (R 4.3.0)
xtable 1.8-4 2019-04-21 [1] RSPM (R 4.3.0)
XVector 0.42.0 2023-10-24 [1] Bioconductor
yaml 2.3.8 2023-12-11 [1] RSPM (R 4.3.0)
yardstick 1.2.0 2023-04-21 [1] RSPM (R 4.3.0)
zlibbioc 1.48.0 2023-10-24 [1] Bioconductor
zoo 1.8-12 2023-04-13 [1] RSPM (R 4.3.0)
[1] /home/mischko/R/x86_64-pc-linux-gnu-library/4.3
[2] /opt/R/4.3.1/lib/R/library
──────────────────────────────────────────────────────────────────────────────